home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / language / parallax / more_exa.tar / more / Music / fractal_music.p next >
Text File  |  1993-03-05  |  4KB  |  129 lines
  1. SYSTEM fractal_music;
  2. (* This program generates fractal music. Its output is saved in MIDI file *)
  3. (* format, which can be played on a synthesizer with a sequencer          *)
  4. (* Thomas Braunl, Univ. Stuttgart, 1993                                   *)
  5. CONST  maxlevel = 5;
  6.        low_val  = 0.0;
  7.        high_val = 1.0;
  8.        maxnode  = 2**maxlevel - 1;
  9. TYPE   list     = ARRAY [1..maxnode] OF REAL;
  10. (* specification of binary tree-structure *)
  11. CONFIGURATION tree [1..maxnode];
  12. CONNECTION    child_l : tree[i] <-> tree[2*i].parent;
  13.               child_r : tree[i] <-> tree[2*i+1].parent;
  14. SCALAR  i,j         : INTEGER;
  15.         delta       : REAL;
  16.         field       : list;
  17. VECTOR  x, low, high: REAL;
  18.  
  19. PROCEDURE Gauss(): VECTOR REAL;
  20. (* random number with Gaussian distribution *)
  21. CONST N = 4;
  22.       GA= SQRT(3.0*FLOAT(N));
  23.       GF= 2.0*GA / (FLOAT(N)*FLOAT(MAX(INTEGER)));
  24. SCALAR i  : INTEGER; 
  25. VECTOR sum: REAL;
  26. BEGIN
  27.   sum:=0.0;
  28.   FOR i:=1 TO N DO sum:= sum + FLOAT(VIRandom()) END;
  29.   RETURN (GF*sum - GA)
  30. END Gauss;
  31.  
  32. PROCEDURE MidPointRec(SCALAR delta: REAL; SCALAR level: INTEGER);
  33. BEGIN
  34.   PARALLEL [2**(level-1) .. 2**level - 1]  (* select current tree level *)
  35.     x := 0.5 * (low + high) + delta*Gauss();
  36.     IF level < maxlevel THEN
  37.       SEND tree.child_l (low)  TO tree.parent(low); (* values for children *)
  38.       SEND tree.child_l (x)    TO tree.parent(high);
  39.       SEND tree.child_r (x)    TO tree.parent(low);
  40.       SEND tree.child_r (high) TO tree.parent(high);
  41.     END;
  42.   ENDPARALLEL;
  43. END MidPointRec;
  44.  
  45.  
  46. PROCEDURE WriteMidiFile(SCALAR f: list);
  47. CONST text        = "Parallaxis Music - Braunl, Univ. Stuttgart '93";
  48.       textlen     = 46;
  49.       bottom      = 60;   (* MIDI no. of note C3 *)
  50.       range       = 12.0; (* one octave *)
  51.       forte       = 96;   (* key pressure *)
  52.       mezzoforte  = 64;   (* key pressure *)
  53.       piano       = 32;   (* key pressure *)
  54. TYPE  string      = ARRAY[1..30] OF CHAR;
  55.  
  56.  PROCEDURE WriteLen(SCALAR l: INTEGER);
  57.  SCALAR l2,l3,l4: INTEGER;
  58.  BEGIN (* write argument as 4 bytes *)
  59.    l4 := l MOD 256; l := l DIV 256;
  60.    l3 := l MOD 256; l := l DIV 256;
  61.    l2 := l MOD 256; l := l DIV 256; (* now l only has its most sig. byte *)
  62.    Write(CHR(l));  Write(CHR(l2));  Write(CHR(l3));  Write(CHR(l4));
  63.  END WriteLen;
  64.  
  65.  PROCEDURE WriteHex(SCALAR s: string);
  66.  SCALAR i,hex: INTEGER;
  67.  BEGIN (* interpret argument as hex string *)
  68.    i:=1;
  69.    WHILE s[i] # CHR(0) DO
  70.      IF s[i] <= '9'   THEN hex := 16 * (ORD(s[i]) - ORD('0'))
  71.                       ELSE hex := 16 * (ORD(s[i]) - ORD('A') + 10)
  72.      END;
  73.      IF s[i+1] <= '9' THEN inc(hex, ORD(s[i+1]) - ORD('0'))
  74.                       ELSE inc(hex, ORD(s[i+1]) - ORD('A') + 10)
  75.      END;
  76.      Write(CHR(hex));
  77.      inc(i,2);
  78.      WHILE s[i] = ' ' DO inc(i,1) END;  (* skip blanks *)
  79.    END
  80.  END WriteHex;
  81.  
  82.  PROCEDURE inorder(SCALAR node: INTEGER);
  83.  SCALAR note: INTEGER;
  84.  BEGIN
  85.    IF node <= maxnode THEN
  86.      inorder(2*node);
  87.       note := bottom + TRUNC(range*field[node]);
  88.       WriteHex("00 90"); Write(CHR(note)); Write(CHR(mezzoforte)); (* note on *)
  89.       WriteHex("60 80"); Write(CHR(note)); Write(CHR(mezzoforte)); (* note off*)
  90.      inorder(2*node+1);                             (* duration 60 = 1/4 note *)
  91.    END
  92.  END inorder;
  93.  
  94. BEGIN
  95.   OpenOutput("fractal.midi");
  96.   WriteString("MThd");                 (* header and fixed length *)
  97.   WriteLen(6);
  98.   WriteHex("00 00  00 01  00 60");     (* format 0, track 1, div.for 1/4 note *)
  99.  
  100.   WriteString("MTrk");                 (* track and calculated length *)
  101.   WriteLen(maxnode*8 +3 +textlen +18 +4);
  102.   WriteHex("00 FF 01");                (* text *)
  103.   Write(CHR(textlen));                 (* text length *)
  104.   WriteString(text);
  105.   WriteHex("00 FF 58 04 04 02 18 08"); (* time signature *)
  106.   WriteHex("00 FF 51 03 07 A1 20");    (* tempo *)
  107.   WriteHex("00 C0 01");                (* track 1 (no. 0) on program/sound 1 *)
  108.   
  109.   inorder(1);                          (* print all array elements as notes *)
  110.   WriteHex("00 FF 2F 00");             (* end of track *) 
  111.   CloseOutput;
  112. END WriteMidiFile;
  113.  
  114.  
  115. BEGIN (* main *)
  116.   PARALLEL
  117.     low  := low_val;   (* starting values *)
  118.     high := high_val;
  119.     x := 0.0;
  120.   ENDPARALLEL;
  121.   FOR i:=1 TO maxlevel DO
  122.     delta := 0.5 ** (FLOAT(i)/2.0);
  123.     MidPointRec(delta,i);
  124.   END;
  125.   STORE(x,field);
  126.   WriteMidiFile(field);
  127. END fractal_music.
  128.  
  129.